BEGIN
REQUIRE "IODEFS[1,BLF]" SOURCE_FILE;


DEFINE ITT(X,N) = "FOR X←1 STEP 1 UNTIL N DO";
DEFINE ∂=" &BLANK1& ";
STRING BLANK1,BLANK10,BLANK20,DELIMSS,FORMFEED;


INTEGER DICE, SW, P, P1, Q, Q1, I, I1, J, J1, K, K1, W, L, T, WFLAG;
INTEGER NEXTL,NEXTA,LI,SSLEN,ATLEN,ERROR,IDUM,INCH1,INCH2,EOF1,EOF2;
REAL R, RR, RRR;
STRING S, SS, SSS,ST,SY,SV,FILENAME,SU,LASTNAME,LASTLINE,ZEROKS,TOPIC,LASTB,AREA;
STRING OUTFILE,RATER,DIM,INTNAME;
STRING S1,S2,S3;

STRING PROC RIGHTZ(INTEGER L; STRING S);
	RETURN(IF LN(S)<L THEN ZEROKS[1 TO L-LN(S)]&S  ELSE S[1 TO L]);

STRING PROC OFFS(STRING S; INTEGER I);
  BEGIN STRING ST; INTEGER L;  L←LENGTH(S);
  IF I<L THEN ST←S[I+1 TO L] ELSE ST←NULL;  RETURN (ST) ;  END;

PROC ERRORMESS(STRING S);
	BEGIN SAY(S ↓ ↓ );  SAY("please copy this down and notify someone" ↓ ↓ );
	END;
PROC FATALERROR(STRING S);
	BEGIN INTEGER I; ERRORMESS(S); RELEASE(INCH); I←CALL(0,"EXIT"); END;

BOOLEAN PROC EQS(STRING S);	
	RETURN(IF EQU(S,NULL) OR S=" " THEN TRUE ELSE FALSE);

STRING PROC READIN(INTEGER CHAN);
  BEGIN STRING S; S←INPUT(CHAN,1); 
  WHILE ¬EOF AND EQS(S) DO S←INPUT(CHAN,1);
  IF EOF THEN IF CHAN=INCH1 THEN EOF1←EOF ELSE EOF2←EOF;  RETURN(S);  END;

PROC OUTB(INTEGER CHAN; STRING S);
  BEGIN IF ¬EQU(SV,S[1 TO 6]) THEN BEGIN OUT(OUCH, NULL ↓ ); SV←S[1 TO 6]; END;
  OUT(OUCH, S);  END;

STRING PROC READNOC(INTEGER I);
  BEGIN STRING S,SDUM; INTEGER FLAG; FLAG←0; 
    WHILE ¬EOF AND ¬EOF1 AND ¬EOF2 AND FLAG=0 DO BEGIN  S←READIN(I); 
	IF EQU(S[1 TO 1],FORMFEED) THEN SDUM←LOP(S);
	IF EQU(S[1 TO 4],"(***") THEN FLAG←0
	ELSE IF EQU(S,NULL) THEN FLAG←0
	ELSE IF EQU(S," ") THEN FLAG←0
	ELSE FLAG←1;	END;
	RETURN (S);  END;


PROC READCOMMENT(INTEGER I);
BEGIN  IF EQU(SS[1 TO 7], "COMMENT") THEN BEGIN
	  WHILE ¬EQU(SS[2 TO 2],";") AND ¬EQU(SS[3 TO 3],";") AND ¬EOF1 AND ¬EOF2
		DO   SS←READIN(I);
	  SS←READIN(I);
	  END;  END;


INTEGER PROCEDURE SLESS(STRING S1,S2);
	BEGIN "SLESS"
	INTEGER C1,C2;
	C1←LOP(S1); C2←LOP(S2);
	WHILE C1 ∧ C2 ∧ C1=C2 DO
		BEGIN
		C1←LOP(S1); C2←LOP(S2);
		END;
	RETURN(IF C1=C2 THEN 0 ELSE IF C1 < C2 THEN -1 ELSE 1)
	END "SLESS";
COMMENT  RETURNS -1 IF S1<S2,  +1 IF S1>S2  ;

INTEGER PROCEDURE BLANKLINE(STRING S2);
	BEGIN "BLANKLINE"
	INTEGER C,C1,C2;  STRING S;  S←S2;
	C←LOP(S); C1←32;  C2←9;
	IF C=0 THEN RETURN(1); 
	WHILE C ∧ ((C=C1) OR (C=C2))   DO   C←LOP(S);

	RETURN(IF C=0 THEN 1 ELSE 0)
	END "BLANKLINE";
COMMENT  RETURNS 1 IF S=BLANKS OR TABS, 0 IF NOT   ;


FORMFEED← '14;
ZEROKS←"000000000000";
BLANKS←"                                                   ";
BLANK1←"   ";
BLANK20←"                    ";
BLANK10←"          ";
FLAG←0;
STDBRK(INCH);
DELIMSS← '15 & '12 & '40 & '11 & '14;
SETBREAK(1, '12, '14 & '15, "INS");
SETBREAK(13, '12 & '40, '15, "INS");
SETBREAK(14,DELIMSS & " ?.()","","INR");
SETBREAK(15,"αλ","","INR");

COMMENT  BREAKSETS 17 AND 18 ARE RESERVED FOR TEMPORARY USE;

SW←0; J←0;

COMMENT ********************************* ;

WHILE TRUE DO  BEGIN	"TOPBLOCK"

S←ASK("H FOR HELP -- GO?");

IF EQU(S, "X") THEN DONE "TOPBLOCK";

IF EQU(S, "H") THEN BEGIN

SAY("R for rating dialogs between doctors and patients "  ↓ ↓ );
SAY("F for Franks routine to edit a dialog file" ↓ ↓ ↓ );

END;  COMMENT END OF H ROUTINE;

COMMENT  R ROUTINE FOR RATING DIA FILES;

IF EQU(S,"R") THEN BEGIN "R"

SAY("routine to rate dialog files  " ↓ );
SETBREAK(17,"#","","INR");
SETBREAK(18,"%","","INR");

ERROR←1;
WHILE ERROR DO BEGIN "RATER"
RATER←ASK(NULL ↓ & "Rater's name=");
FILIN(RATER&".TSK");
IF FLAG≠0 THEN SAY(RATER&" not recognized as a rater -- try again" ↓ ↓ )
  ELSE ERROR←0;
END "RATER" ;
SAY("  Rater's name is "&RATER ↓ ↓ );  RELEASE(INCH);

WHILE TRUE DO BEGIN "NEWONE"

COMMENT ***** SET INTNAME AND DIM ;

FILIN(RATER&".TSK");
SS←INPUT(INCH,1);  ERROR←1;
WHILE NOT EOF DO BEGIN "TSKFILE"
IF ¬EQS(SS) THEN BEGIN ERROR←0; TOPIC←SS; DONE "TSKFILE" ; END;
SS←INPUT(INCH,1);
END "TSKFILE" ;
RELEASE(INCH);

IF ERROR THEN BEGIN SAY("You dont have any files to rate." ↓ ↓ ); 
	 DONE "TOPBLOCK" ; END;
SV←SS;
INTNAME←SS[1 TO 2];  DIM←SS[4 TO ∞];
SAY(NULL ↓ & "doing "&INTNAME&"  "&DIM ↓ ↓ );


COMMENT ***** GET OUTPUT FILE NAME AND OPEN THE OUTPUT FILE ;
FILIN("TMP.FIL[RAT,KMC]"); IF FLAG THEN FATALERROR("NO TMP.FIL");
SS←INPUT(INCH,1);  IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
I←CVD(SS); RELEASE(INCH);
FILOUT("TMP.FIL[RAT,KMC]");  OUT(OUCH, CVS(I+1) ↓ );  RELEASE(OUCH);
OUTFILE←CVS(I)&".TMP";
FILOUT(OUTFILE);
OUT(OUCH, "INT = " & INTNAME & " , DIM = " & DIM & " , RATER = " & RATER ↓ ↓ );

COMMENT ****** FIND WHERE THE INTERVIEW IS ;

FILIN("INDEX");
SS←INPUT(INCH,1);
WHILE NOT EOF AND (2>LENGTH(SS) OR ¬EQU(SS[1 TO 2], INTNAME)) DO SS←INPUT(INCH,1);
	IF EOF THEN FATALERROR("INDEX - CANT FIND INTFILE "&INTNAME);
WHILE NOT EOF AND (2>LENGTH(SS) OR ¬EQU(SS[1 TO 1],"*")) DO SS←INPUT(INCH,1);
	IF EOF THEN FATALERROR("INDEX - NO FILENAME "&INTNAME);
S←SS[2 TO ∞]; RELEASE(INCH);

COMMENT ****** READ THRU THE FILE FOR THE INTERVIEW ;

FILIN(S);
SS←INPUT(INCH,1);  ERROR←1;
WHILE ¬EOF AND ERROR DO BEGIN "READTHRU"
S←SCAN(SS,17,IDUM); 
IF SS AND EQU(SS[3 TO 4],INTNAME) THEN BEGIN ERROR←0; DONE"READTHRU" ; END;
SS←INPUT(INCH,1);
END "READTHRU" ;

IF ERROR THEN FATALERROR("ERROR IN READ -- NO INTERVIEW " &INTNAME );

COMMENT ***** READ PAST THE FIRST JUNK;

SS←INPUT(INCH,1);

WHILE ¬EOF DO BEGIN "READFILE"

COMMENT ************ GET AND PRINT EACH IO PAIR;

S1←S2←S3←NULL;
WHILE ¬EOF AND BLANKLINE(SS) DO SS←INPUT(INCH,1);
S←SS; SU←SCAN(S,18,IDUM); 
IF LENGTH(S)≥9 ∧ EQU(S[1 TO 9],"%(End of ") THEN DONE "READFILE" ;
S1←SS; SS←INPUT(INCH,1); 
IF BLANKLINE(SS) THEN S1←S1[4 TO ∞-2] ELSE 
  BEGIN
  S1←S1[4 TO ∞];  S2←SS; SS←INPUT(INCH,1); 
  IF BLANKLINE(SS) THEN S2←S2[1 TO ∞-2] ELSE 
    BEGIN S3←SS[1 TO ∞-2]; SS←INPUT(INCH,1); END;
  END;

SAY(NULL ↓ ↓ ↓ ↓ ↓ ); 
SAY(S1 ↓ ); IF S2 THEN SAY(S2 ↓ ); IF S3 THEN SAY(S3 ↓ ); SAY(NULL ↓ );


S1←S2←S3←NULL;
WHILE ¬EOF AND BLANKLINE(SS) DO SS←INPUT(INCH,1);
S1←SS; SS←INPUT(INCH,1); 
IF BLANKLINE(SS) THEN S1←S1[3 TO ∞-3] ELSE 
  BEGIN
  S1←S1[3 TO ∞];  S2←SS; SS←INPUT(INCH,1); 
  IF BLANKLINE(SS) THEN S2←S2[1 TO ∞-3] ELSE 
    BEGIN S3←SS[1 TO ∞-3]; SS←INPUT(INCH,1); END;
  END;

SAY(S1 ↓ ); IF S2 THEN SAY(S2 ↓ ); IF S3 THEN SAY(S3 ↓ ); SAY(NULL ↓ );


ERROR←1;

WHILE ERROR=1 DO  BEGIN "ERRORSENT"
SAY("dimension = "&DIM & "     rate 0 1 2 3 4 5 6 7 8 9 " ↓ ↓ );
S←ASK("RATING = ");
  IF EQU(S,"X") THEN DONE "READFILE";
S3←S;  S←LOP(S); I←LOP(S3); IF ¬(48≤I AND I≤57) THEN 
	BEGIN SAY(NULL ↓ & "again:  "); CONTINUE "ERRORSENT"; END;
S1←ASK(NULL ↓ & "The number you selected was  "&S&"   Was that OK? (TYPE Y OR N) " );
IF EQU(S1,"Y") THEN ERROR←0 ELSE SAY(NULL ↓ & "again: ");
END "ERRORSENT" ;

OUT(OUCH, S ↓ );


END "READFILE" ;

SAY(NULL ↓ ↓ ↓ );
SAY(" ***** END OF INTERVIEW ***** " ↓ ↓ );
SAY("thru "&INTNAME ↓ );	 RELEASE(INCH); RELEASE(OUCH);

COMMENT ******** UPDATE THE TASK FILE ;

FILIN(RATER&".TSK");
FILOUT(RATER&".NEW");
SS←INPUT(INCH,1);  ERROR←1;
WHILE NOT EOF DO   BEGIN
IF EQU(SS,SV) THEN OUT(OUCH," "&SS ↓ ) ELSE OUT(OUCH,SS ↓ );
SS←INPUT(INCH,1);
END;

RELEASE(INCH); RELEASE(OUCH);
FILIN(RATER&".TSK");  RENAME(INCH, NULL, 0, IDUM);  RELEASE(INCH);
FILIN(RATER&".NEW");  RENAME(INCH, RATER&".TSK", 0, IDUM); RELEASE(INCH);

S←ASK(NULL ↓ & "do another one[Y or N]?");
IF ¬EQU(S,"Y") THEN DONE "NEWONE";

END "NEWONE" ;

SAY("DONE WITH RATINGS" ↓ );
DONE "TOPBLOCK" ;

END "R" ;
COMMENT  F ROUTINE FOR FRANK HILF;

IF EQU(S,"F") THEN BEGIN "F"

SAY("This formats a file for Frank Hilfs use  " ↓ );

FILENAME←ASK("FILIN="); FILIN(FILENAME);
SS←ASK("FILOUT="); FILOUT(SS);

SS←INPUT(INCH,1); 
I←0;

WHILE NOT EOF DO  BEGIN  "EDIT"

ST←SS;
IF ¬EQS(SS) AND ¬(SS="%") THEN 	BEGIN
  IF I=0 THEN BEGIN ST←"α"&SS&"β";  I←1;  END
   ELSE BEGIN ST←"ε"&SS&"λ";  I←2;	END;
END
ELSE IF I=2 THEN I←0;


OUT(OUCH," "&ST ↓ );
SS←INPUT(INCH,1);

END "EDIT" ;

RELEASE(OUCH); RELEASE(INCH);
END "F" ;
COMMENT  T ROUTINE FOR TESTING THINGS;

IF EQU(S,"T") THEN BEGIN

SAY("1=" & CVS(BLANKLINE("   "))  ↓ );
SAY("1=" & CVS(BLANKLINE("  	 	 "))  ↓ );
SAY("1=" & CVS(BLANKLINE("	  	 	 "))  ↓ );
SAY("1=" & CVS(BLANKLINE(""))  ↓ );
SAY("0=" & CVS(BLANKLINE(" Y "))  ↓ );

END;  COMMENT END OF S=T;


END "TOPBLOCK" ;  COMMENT END TO INFINITE LOOP;

ITT(I,3) RELEASE(INCH); ITT(I,3) RELEASE(OUCH);

    	COMMENT END OF PROGRAM;
END;